home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok32.lha / TestBild / txt / TestBild.mod < prev    next >
Text File  |  1993-08-15  |  6KB  |  208 lines
  1. (*--------------------------------------------------------------------------
  2.     :Program.      Testbild.mod
  3.     :Author.       Andreas Lüdtke
  4.     :Address.      Stangestraße 11, D 2000 Hamburg 50
  5.     :Phone.        040/3905153
  6.     :History.      V1.0, 01-Jan-90, Andreas Lüdtke
  7.     :Copyright.    PD © Andreas Lüdtke 1990.
  8.     :Language.     Modula-2
  9.     :Translator.   M2Amiga 3.3d
  10.     :Imports.      Menu,Screen,Muster von A.Lüdtke
  11.     :Contents.     Hauptmodul Testbild
  12.  ---------------------------------------------------------------------------*)
  13.  
  14. MODULE Testbild;
  15.  
  16. FROM Arts               IMPORT TermProcedure;
  17. FROM Exec               IMPORT WaitPort, ReplyMsg, GetMsg;
  18. FROM SYSTEM             IMPORT ADR, ADDRESS;
  19. FROM Graphics           IMPORT RastPortPtr, SetAPen, SetBPen, SetRast, jam1,
  20.         jam2, SetDrMd;
  21. FROM Intuition          IMPORT IntuiMessagePtr, IDCMPFlags,
  22.         menuNull, IDCMPFlagSet, ScreenPtr, WindowPtr, CloseScreen, NewScreen,
  23.         CloseWindow, NewWindow, IntuiTextPtr, IntuiText, OpenWindow,
  24.         SetWindowTitles, WindowFlags, WindowFlagSet, OpenScreen,
  25.         ScreenToFront, ShowTitle;
  26.  
  27. FROM Menu               IMPORT SetMenu, MenuNum, ItemNum, XStufe, YStufe;
  28. FROM Screen             IMPORT Hoehe, Breite, InitText, OpenScreenAndWindow,
  29.         CloseScreenAndWindow;
  30. FROM Muster             IMPORT ChangeColors, InvertLineColors, DrawLines,
  31.         DrawPixel, DrawSquares, DrawSteps, DrawRects, DrawCircles, DrawPicture;
  32.  
  33. TYPE
  34.   PatternTyp    = (Linien, Punkte, Rechtecke, Kreise, Quadrate, GrauStufen,
  35.                    FarbStufen, TestBild);
  36.  
  37. VAR
  38.   wp            : WindowPtr;
  39.   rp            : RastPortPtr;
  40.   sp            : ScreenPtr;
  41.   Ende          : BOOLEAN;
  42.   MsgPtr        : IntuiMessagePtr;
  43.   code          : CARDINAL;
  44.   class         : IDCMPFlagSet;
  45.   TitelAn       : BOOLEAN;
  46.   Pattern       : PatternTyp;
  47.   oldPattern    : PatternTyp;
  48.   interlace     : BOOLEAN;
  49.   invers        : BOOLEAN;
  50.   oldXStufe     : CARDINAL;
  51.   oldYStufe     : CARDINAL;
  52.  
  53.  
  54. PROCEDURE DoIt;
  55. BEGIN
  56.   InvertLineColors( ADR(sp^.viewPort), invers);
  57.   CASE Pattern OF
  58.   | Linien      : DrawLines   ( rp, XStufe, YStufe);
  59.   | Punkte      : DrawPixel   ( rp, XStufe, YStufe);
  60.   | Rechtecke   : DrawRects   ( rp, XStufe, YStufe);
  61.   | Kreise      : DrawCircles ( rp, XStufe);
  62.   | Quadrate    : DrawSquares ( rp, XStufe, YStufe);
  63.   | GrauStufen  : ChangeColors( ADR(sp^.viewPort), TRUE);
  64.                   DrawSteps   ( rp);
  65.   | FarbStufen  : ChangeColors( ADR(sp^.viewPort), FALSE);
  66.                   DrawSteps   ( rp);
  67.   | TestBild    : ChangeColors( ADR(sp^.viewPort), FALSE);
  68.                   DrawPicture ( rp);
  69.   END;
  70. END DoIt;
  71.  
  72.  
  73. PROCEDURE closeall;
  74. BEGIN
  75.   CloseScreenAndWindow( sp, wp);
  76. END closeall;
  77.  
  78.  
  79. (********************* Haupt-Initialisierungsroutine **********************)
  80.  
  81. PROCEDURE initall;
  82. BEGIN
  83.   TermProcedure( closeall);
  84.   interlace     := FALSE;
  85.   TitelAn       := FALSE;
  86.   Ende          := FALSE;
  87.   invers        := FALSE;
  88.   Pattern       := TestBild;
  89.   oldPattern    := Pattern;
  90.   oldXStufe     := XStufe;
  91.   oldYStufe     := YStufe;
  92.   OpenScreenAndWindow( sp, wp, interlace);
  93.   SetMenu( wp);
  94.   rp := wp^.rPort;
  95.   SetRast( rp, 0);
  96.   ShowTitle( sp, TitelAn);
  97.   DoIt;
  98. END initall;
  99.  
  100.  
  101. (* Serviceroutine für aktiviertes Menü *)
  102. PROCEDURE ServeMenus;
  103. VAR
  104.   menu          : CARDINAL;
  105.   item          : CARDINAL;
  106. BEGIN
  107.   menu  := MenuNum( code);
  108.   item  := ItemNum( code);
  109.   CASE menu OF
  110.   | 0: (* Projekt *)
  111.     CASE item OF
  112.     | 0: TitelAn := NOT TitelAn;
  113.          ShowTitle( sp, TitelAn);
  114.     | 1: interlace := NOT interlace;
  115.          CloseScreenAndWindow( sp, wp);
  116.          OpenScreenAndWindow( sp, wp, interlace);
  117.          SetMenu( wp);
  118.          ShowTitle( sp, TitelAn);
  119.          rp := wp^.rPort;
  120.          SetRast( rp, 0);
  121.          SetAPen( rp, 0);
  122.          SetBPen( rp, 10);
  123.          SetDrMd( rp, jam1);
  124.          ScreenToFront(sp);
  125.          DoIt;
  126.     | 2: Ende := TRUE;
  127.     END;
  128.   | 1: (* Muster *)
  129.     CASE item OF
  130.     | 0: invers := NOT invers;  (* inverse Farben       *)
  131.          InvertLineColors( ADR(sp^.viewPort), invers);
  132.     | 1: Pattern := Linien;             (* Linienmuster         *)
  133.     | 2: Pattern := Punkte;             (* Punktemuster         *)
  134.     | 3: Pattern := Rechtecke;          (* Rechtecke            *)
  135.     | 4: Pattern := Kreise;             (* Kreise               *)
  136.     | 5: Pattern := GrauStufen;         (* Grautreppe           *)
  137.     | 6: Pattern := FarbStufen;         (* Farbtreppe           *)
  138.     | 7: Pattern := Quadrate;           (* Schachbrett          *)
  139.     | 8: Pattern := TestBild;           (* Testbild             *)
  140.     END;
  141.   | 2: (* X-Auflösung *)
  142.     CASE item OF
  143.     | 0: XStufe := 2;
  144.     | 1: XStufe := 4;
  145.     | 2: XStufe := 8;
  146.     | 3: XStufe := 16;
  147.     | 4: XStufe := 32;
  148.     | 5: XStufe := 64;
  149.     | 6: XStufe := 128;
  150.     END;
  151.   | 3: (* Y-Auflösung *)
  152.     CASE item OF
  153.     | 0: YStufe := 2;
  154.     | 1: YStufe := 4;
  155.     | 2: YStufe := 8;
  156.     | 3: YStufe := 16;
  157.     | 4: YStufe := 32;
  158.     | 5: YStufe := 64;
  159.     | 6: YStufe := 128;
  160.     END;
  161.   END;
  162.   IF oldPattern#Pattern THEN
  163.     DoIt;
  164.   END;
  165.   IF (oldXStufe#XStufe) OR (oldYStufe#YStufe) THEN
  166.     CASE Pattern OF
  167.     | Linien    : DrawLines  ( rp, XStufe, YStufe);
  168.     | Punkte    : DrawPixel  ( rp, XStufe, YStufe);
  169.     | Rechtecke : DrawRects  ( rp, XStufe, YStufe);
  170.     | Kreise    : DrawCircles( rp, XStufe);
  171.     | Quadrate  : DrawSquares( rp, XStufe, YStufe);
  172.     ELSE
  173.       ;
  174.     END;
  175.   END;
  176.   oldXStufe := XStufe;
  177.   oldYStufe := YStufe;
  178.   oldPattern:= Pattern;
  179. END ServeMenus;
  180.  
  181.  
  182. (* Serviceroutine für evtl. aktivierte Gadgets und Menüs *)
  183. PROCEDURE Server;
  184. BEGIN
  185.   LOOP
  186.     MsgPtr := GetMsg(wp^.userPort); (* Message holen *)
  187.     IF (MsgPtr = NIL) THEN EXIT END;
  188.     (* Wenn Message da, dann reagieren... *)
  189.     class := MsgPtr^.class; code := MsgPtr^.code;
  190.     ReplyMsg( MsgPtr);
  191.     IF ((class = IDCMPFlagSet{ menuPick}) & (code#menuNull)) THEN
  192.       ServeMenus;
  193.     END;
  194.   END;
  195. END Server;
  196.  
  197.  
  198. (************* Hauptprogramm ******************)
  199.  
  200. BEGIN
  201.   initall;
  202.   ScreenToFront(sp);
  203.   REPEAT
  204.     WaitPort( wp^.userPort);    (* Warten bis irgendeine Message kommt  *)
  205.     Server;
  206.   UNTIL Ende;
  207. END Testbild.mod
  208.